(ns fxbattle.server.core
 (:gen-class))

(def *base-probability* 10)
(def *base-generation-rate* 2)
(def *generation-rate* 1)
(def *path-capacity* 3)
(def *attack-weight* 1)
(def *wrapping* false)

(def *max-troops* 100)
(def *max-elevation* 10)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;; fx battle structs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; An RGB color
(defstruct color :red :blue :green)

;;; A player has a name and color. The game supports an arbitrary number of
;;; players. Name is currently the ID.
(defstruct player :name :color)

;;; A struct describing a single army
(defstruct army :owner :troops)

;;; Cells form the battle map in a arbitrary arrangement. They are arranged in a
;;; 2D grid and are identified by their [x, y] indices.
(defstruct cell :x :y :z :army :base)

;;; Path between two cells.
(defstruct path :origin :destination :players)

;;; A game is the battle field and the participating players
(defstruct game :width :height :cell-grid :cell-list :path-grid :path-list 
  :players :started)

;;; Sets the troop level for this cell
(defn- set-troops
  "Sets the number of troops for the given army. Must be called in a transaction."
  [army troops]
  (alter army assoc :troops (max 0 (min *max-troops* troops))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Data ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Predefined player colors. Currently supporting up to six players
(def colors [(struct-map color :red 255 :blue 0 :green 0)
             (struct-map color :red 0 :blue 255 :green 0)
             (struct-map color :red 0 :blue 0 :green 255)
             (struct-map color :red 255 :blue 255 :green 0)
             (struct-map color :red 255 :blue 0 :green 255)
             (struct-map color :red 0 :blue 255 :green 255)])

;;; Directions as (x,y) offsets. Alternating rows have different offsets to
;;; their neighbours.
(def even-directions #{[-1 0] [-1 1] [0 1] [1 0] [0 -1] [-1 -1]})
(def odd-directions  #{[-1 0] [ 0 1] [1 1] [1 0] [1 -1] [ 0 -1]})

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; "Constructors" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- make-player
  "Creates and returns a player struct with the given name and assigned color."
  [name color]
  (struct-map player :name name :color color))

(defn- make-army
  "Creates and returns an army struct with the given owner and 0 initial troops."
  [owner]
  (struct-map army :owner owner :troops 0))

(defn- make-cell
  "Create and returns a cell struct at the given (x,y) index, a default elevation
and an empty army."
  [x y]
  (struct-map cell
    :x x :y y :z (rand-int *max-elevation*)
    :base (= 0 (rand-int *base-probability*))
    :army (ref (make-army nil)))) ; Army is the mutable part of the struct but init to nil

(defn- make-path
  "Creates and returns a path struct with the given origin and destination cells,
and a reference to an empty set of players."
  ([origin destination]
    (struct-map path :origin origin :destination destination :players (ref #{}))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Initialization  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn- make-cells
  "Creates and returns a two dimensional vector of cell structs with the given
height and width. Indexing these cells is by height then width."
  [height width]
  (apply vector
    (map (fn [x] (apply vector (map #(make-cell x %) (range width))))
      (range height))))

(defn- get-cell
  "Find and return the cell at the given (x,y) location."
  [x y cells]
  (when (and (< -1 x (count cells))
             (< -1 y (count (first cells))))
    (-> cells (nth x) (nth y))))

(defn- make-paths
  "Create the set of legal paths between the cells in the given set"
  [cells]
  (apply vector
    (map (fn [cell-row]
           (apply vector
             (map (fn [origin]
                    (remove #'nil?
                      (map (fn [[xoff yoff]]
                             (let [dest (get-cell (+ (:x origin) xoff) (+ (:y origin) yoff) cells)]
                               (when dest (make-path origin dest))))
                        (if (odd? (:y origin)) odd-directions even-directions))))
               cell-row)))
      cells)))

;;;
(defn get-path
  "Finds and returns the path between the given locations"
  [orig-x orig-y dest-x dest-y path-grid]
  (let [paths (-> path-grid (nth orig-x) (nth orig-y))]
    (first
      (filter
        (fn [path] (and (= dest-x (:x (:destination path)))
                     (= dest-y (:y (:destination path)))))
        paths))))

(defn find-path
  "Finds and returns the path between the given locations"
  [orig-x orig-y dest-x dest-y game]
  (get-path orig-x orig-y dest-x dest-y (:path-grid game)))

(defn- flatten
  "Takes any nested combination of sequential things (lists, vectors,
  etc.) and returns their contents as a single, flat sequence.
  (flatten nil) returns nil."
  [x]
  (filter (complement sequential?)
          (rest (tree-seq sequential? seq x))))

;;;;;;;;;;;;;;;;;;;;;;;;; Public Interface ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Create a new game
(defn make-game 
  "Create a new game with the given width, height and number of players."
  [height width]
  (let [cells (make-cells height width)
        paths (make-paths cells)]
    (struct-map game
      :width  width
      :height height
      :cell-grid cells
      :cell-list (flatten cells)
      :path-grid paths
      :path-list (flatten paths)
      ; Mutable portion, init to refs to empty lists. Players may be added as
      ; we go and the active paths are specific to players.
      :players (ref ())
      :started (atom false))))

;;; Adds another player to the game
(defn add-player 
  "Adds another player to the game"
  [name {players :players width :width height :height cell-grid :cell-grid}]
  (let [player (make-player name (nth colors (count @players)))
        cell (get-cell (rand-int height) (rand-int width) cell-grid)
        army (:army cell)]
    (dosync
      (alter players conj player)
      (alter army assoc :owner player)
      (alter army assoc :troops *max-troops*))
    player))

(defn remove-player
  "Removes the given player from the game"
  [player {players :players}]
  (dosync (alter players disj player)))

;;; Add a path to the game
(defn set-path
  "Sets the active state of the path between (orig-x, orig-y) and (dest-x, dest-y)
for the given player. If that path is active for the given player, the player is
added to the active list, otherwise the player is removed."
  [orig-x orig-y dest-x dest-y active player game]
  (let [path (find-path orig-x orig-y dest-x dest-y game)]
    (when path
      (dosync
        (if active
          (alter (:players path) conj player)
          (alter (:players path) disj player)))
      path)))

(defn remaining-players
  "Returns a set of the remaining players"
  [{cell-list :cell-list}]
  (set (remove #'nil? (map (fn [cell] (:owner @(:army cell))) cell-list))))

(defn game-over?
  "Predicate: checks whether the game is over or not. The game is over when only
one player has armies left on the board."
  [game]
  (or (= 1 (count (remaining-players game)))
    (= 0 (count @(:players game)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Game Simulation ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defn generate-troops 
  "Applies the troop generation to this cell if it has an owner"
  [{army :army base :base}]
  (when (:owner @army)
    (dosync
      (set-troops army (+ (:troops @army) 
                         (if base *base-generation-rate* *generation-rate*))))))

(defn capacity
  "Computes the effective capacity of the given path based upon the cell elevations
and the paths inherent capacity"
  [{origin :origin destination :destination}]
  (* *path-capacity* (+ 1 (/ (- (:z origin) (:z destination)) *max-elevation*))))

;;; Checks whether this path indicates an attack by connecting cells with different
;;; owners. If so, determines the outcome of that attack by killing off some troops
(defn resolve-attack 
  "Checks whether this path indicates an attack by connecting cells with different
owners. If so, determines the outcome of that attack by killing off some troops."
  [path]
  (let [orig-army (:army (:origin path))
        dest-army (:army (:destination path))]
    ; When the path owner owns the origin cell but not the destination cell
    (when (and (contains? @(:players path) (:owner @orig-army))
            (not (= (:owner @orig-army) (:owner @dest-army))))
      (dosync
        (let [troops (min (capacity path) (:troops @orig-army) (:troops @dest-army))]
          (set-troops orig-army (- (:troops @orig-army) troops))
          (set-troops dest-army (- (:troops @dest-army) (* troops *attack-weight*))))))))

;;; Checks whether this path can be used for movement. If the path owner owns the
;;; origin then troops can move if the owner owns the destination or the destination has no
;;; troops.
(defn move-troops 
  "Checks whether this path can be used for movement. If the path owner owns the
origin then troops can move if the owner owns the destination or the destination has no
troops."
  [path]
  (let [orig-army (:army (:origin path))
        dest-army (:army (:destination path))]
    (when (contains? @(:players path) (:owner @orig-army))
      (dosync
        ; If the destination is empty the path owner now owns it
        (when (<= (:troops @dest-army) 0)
          (alter dest-army assoc :owner (:owner @orig-army)))
        (when (= (:owner @orig-army) (:owner @dest-army))
          (let [troops (min (capacity path)
                         (:troops @orig-army)
                         (- *max-troops* (:troops @dest-army)))]
            (set-troops orig-army (- (:troops @orig-army) troops))
            (set-troops dest-army (+ (:troops @dest-army) troops))))))))

;;;;;;;;;;;;; Main Drivers ;;;;;;;;;;;;;;;;;;;

(defn do-generate-troops
  "Does troop generation for all cells in the battlefield"
  [{cell-list :cell-list}]
  (dorun (map #'generate-troops cell-list)))

(defn do-resolve-attacks
  "Updates the game state based upon all active paths"
  [{path-list :path-list}]
  (dorun (map #'resolve-attack path-list)))

(defn do-move-troops
  "Makes all available moves"
  [{path-list :path-list}]
  (dorun (map #'move-troops path-list)))

(defn do-update 
  "Runs a single tick of the game simulation"
  [game]
  (do-generate-troops game)
  (do-resolve-attacks game)
  (do-move-troops     game))

;;;;;;;;;;;;;;;;;;;;; Stuff ;;;;;;;;;;;;;;;;;;;;;

(defn dc 
  "Pretty print a cell state"
  [cell]
  (println "(" (:x cell) "," (:y cell) ") +" (:troops @(:army cell)) "~" (:base cell))) ; " : " (:name (:owner @cell))))

(defn dp 
  "Pretty print a path"
  [path]
  (let [origin (:origin path) dest (:destination path)]
    (println "[(" (:x origin) "," (:y origin) ") -> (" (:x dest) "," (:y dest) ")] :" @(:players path))))

(defn dpl 
  "Pretty print a list of paths"
  [paths]
  (dorun (map #'dp paths)))

(defn dg 
  "Pretty print the game state"
  [game]
  (dorun (map (fn [row] (dorun (map #'dc row)))  (:cell-grid game)))
  (dorun (map (fn [row] (dorun (map #'dpl row))) (:path-grid game)))
  )
